home *** CD-ROM | disk | FTP | other *** search
/ The Game Master (3rd Edition) / The Game Master 3rd edition.iso / files / game_cga / gameplus / wa-tor.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-05-30  |  33.8 KB  |  1,029 lines
  1. {$C-}
  2. Program WaTor (input,output);                                      {.CP48}
  3.   {An implementation of the "Wa-tor" world program described in
  4.    A. K. Dewdney's column in Scientific American, Dec., 1984,
  5.    pp. 14-22.  Dewdney described a program built on arrays, but
  6.    suggested that it might go faster if built on linked lists.
  7.    This version was made by R. N. Wisan in Dec. 1984 using that
  8.    linked lists method.}
  9.  
  10. {If requested, this program makes a data file which can be printed out
  11.  and the first 320 Chronons can be graphed}
  12.  
  13. Type
  14.    Spoint    =     ^Shark;
  15.    Fpoint    =     ^Fish;
  16.    Shark     =     record
  17.                       Row:   0..24;
  18.                       Col:   0..49;
  19.                       age:   byte;
  20.                       ate:   byte;
  21.                       next:  Spoint;
  22.                       last:  Spoint;
  23.                    end;
  24.    Fish      =     record
  25.                       Row:   0..24;
  26.                       Col:   0..49;
  27.                       age:   byte;
  28.                       next:  Fpoint;
  29.                    end;
  30.    FileRec   =      record
  31.                        Sharks: integer;
  32.                        Fhigh:  integer;
  33.                        Flow:   integer;
  34.                        Sbred:  integer;
  35.                        Sdied:  integer;
  36.                        Fbred:  integer;
  37.                        Featen: integer;
  38.                     end;
  39.    regpack   =     record
  40.                       ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  41.                    end;
  42.    Str255    =     string[255];
  43.    Str3      =     string[3];
  44.  
  45. Var
  46.    Fil:            File of FileRec;
  47.    Dat:            FileRec;
  48.    GrafOrTable:    (Graf,Table,Quit);
  49.  
  50.    X,S1,S2,
  51.    Fh1,Fh2,
  52.    Fl1,Fl2,
  53.    Sbr,Sdie,Fbr:   integer;
  54.    Ch:             char;
  55.  
  56.    R,Lin,Chron,
  57.    Seg,Page:       integer;
  58.    Op:             text;
  59.  
  60.  
  61. Procedure GetScreen;                                                  {.CP11}
  62. {Determine whether color or mono board is present}
  63. Var
  64.    Regs:           RegPack;
  65.    B:              byte;
  66. Begin
  67.    intr($11,Regs);
  68.    if (Regs.Ax and 48)=48 then             {Monochrome board}
  69.       Seg := $B000
  70.    else                                    {Color/Graphics board}
  71.       Seg := $B800
  72. end; {GetScreen}
  73.  
  74. Procedure Ctr(Line:Str255; row:byte);                                 {.CP10}
  75. Var
  76.    I,L:           byte;
  77. Begin
  78.    L := 40 - (Length(Line)div 2);
  79.    LowVideo;
  80.    GotoXY(1,Row);
  81.    For I := 1 to L do
  82.       write(' ');
  83.    write(Line);
  84. (*   For I := (L+Length(Line)) to 79 do
  85.       write(' ') *)
  86. End; {Ctr}
  87.  
  88. Procedure GetGrafOrTable;                                             {.CP28}
  89. Var
  90.    Ch:             char;
  91.    Lin:            byte;
  92. Begin
  93.    ClrScr;
  94.    LowVideo;
  95.    Lin := 3;
  96.    Ctr('You can make a graph or a table of the last recorded run',Lin);
  97.    Lin := Lin + 1;
  98.    Ctr('(Enter G for a graph, T for a table, or Q to quit: ',Lin);
  99.    Lin := Lin + 1;
  100.    Repeat
  101.       read(Trm,Ch);
  102.       Lin := Lin + 2;
  103.       if not (Ch in ['G','g','T','t','Q','q']) then begin
  104.          Ctr('You must answer G, T, or Q ',Lin);
  105.          Lin := Lin + 1
  106.       end {if}
  107.    Until Ch in ['G','g','T','t','Q','q'];
  108.    If Ch in ['G','g'] then
  109.       GrafOrTable := Graf
  110.    else if Ch in ['T','t'] then
  111.       GrafOrTable := Table
  112.    else
  113.       GrafOrTable := Quit
  114. End; {GetGrafOrTable}
  115.  
  116. Procedure GetTableOrQuit;
  117. Var
  118.    Ch:             char;
  119.    Lin:            byte;
  120. Begin
  121.    ClrScr;
  122.    LowVideo;
  123.    Lin := 3;
  124.    Repeat
  125.       Ctr('Do you want a readout of the last recorded run? (Y/N) ',Lin);
  126.       read(Trm,Ch);
  127.       If Not (Ch in ['Y','y','N','n']) then begin
  128.          Lin := Lin + 2;
  129.          Ctr('You must answer Y or N ',Lin);
  130.          Lin := Lin + 1
  131.       end {if}
  132.    until Ch in ['Y','y','N','n'];
  133.    If Ch in ['Y','y'] then
  134.       GrafOrTable := Table
  135.    else
  136.       GrafOrTable :=  Quit
  137. End; {TableOrQuit}
  138.  
  139. Procedure OpenDataFile;                                               {.CP13}
  140. Begin
  141.    Assign(Fil,'WA-TOR.DAT');
  142.    {$I-} Reset(Fil) {$I+};
  143.    If IOresult<>0 then begin
  144.       ClrScr;
  145.       LowVideo;
  146.       GotoXY(20,10); Write('     Oh! Oh!  Can''t find the Data File.');
  147.       GotoXY(20,12); write('File WA-TOR.DAT should be on the default drive.');
  148.       GotoXY(20,13); write('        Check it out and try again.');
  149.       Halt
  150.    End {If}
  151. End; {OpenDataFile}
  152.  
  153. Overlay Procedure WaGraf;                                             {.CP13}
  154. Var
  155. Fish,Shark:        integer;
  156.    
  157.  
  158.    Function Pct(X: integer): integer; forward;
  159.  
  160.    Procedure GetInitial;
  161.    Begin
  162.       Read(Fil,Dat);
  163.       Shark := Dat.Sharks;
  164.       Fish  := Dat.Fhigh;
  165.       Sbr   := Dat.Sbred;
  166.       Sdie  := Dat.Sdied;
  167.       Fbr   := Dat.Fbred;
  168.    End; {GetInitial}
  169.  
  170.    Procedure GrBox;                                                   {.CP11}
  171.    Var
  172.      X,Y:             integer;
  173.  
  174.       Procedure Outline;
  175.       Begin
  176.          Draw(0,0,319,0,3);
  177.          Draw(319,0,319,199,3);
  178.          Draw(319,199,0,199,3);
  179.          Draw(0,199,0,0,3);
  180.       End; {OutLine}
  181.  
  182.       Procedure Verticals;                                            {.CP13}
  183.       Var
  184.          I:           integer;
  185.       Begin
  186.          For I := 1 to 3 do begin
  187.             X := I*100 - 1;
  188.             Y := 2;
  189.             While Y<200 do begin
  190.                Plot(X,Y,3);
  191.                Y := Y + 2
  192.             end {while}
  193.          end {For I}
  194.       End; {Verticals}
  195.  
  196.       Procedure Horizontals;                                           {CP19}
  197.       Var
  198.          I:           integer;
  199.       Begin
  200.          For I := 1 to 3 do begin
  201.             Y := I*50 - 1;
  202.             X := 2;
  203.             While X<319 do begin
  204.                Plot(X,Y,3);
  205.                X := X + 2
  206.             end {while}
  207.          end {for I}
  208.       End; {Horizontals}
  209.  
  210.    Begin {GrBox}
  211.       Outline;
  212.       Verticals;
  213.       Horizontals
  214.    End; {GrBox}
  215.  
  216.    Procedure DrawLine;                                                 {.CP8}
  217.    Begin
  218.       Draw(X,S2,X-1,S1,3);
  219.       Draw(X,Fl2,X-1,Fl1,3);
  220.       Draw(X,Fh2,X-1,Fh1,3);
  221.    End; {DrawLine}
  222.  
  223.    Procedure Opening;                                                 {.CP14}
  224.    Var
  225.       Ch:             char;
  226.    Begin
  227.       ClrScr;
  228.       LowVideo;
  229.       GotoXY(15,3);  write(' IF YOU WANT A GRAPH OF THE DATA:');
  230.       GotoXY(15,5);  write('    1. WA-TOR.DAT must be on default drive,');
  231.       GotoXY(15,7);  write('    2. If you want the graph printed out,');
  232.       GotoXY(15,8);  write('       DOS 2.0 GRAPHICS must be installed.');
  233.       GotoXY(15,12); write(' WHEN THE GRAPH IS FINISHED:');
  234.       GotoXY(15,14); write('    Press P if you want it printed out,');
  235.       GotoXY(15,15); write('    Press any other key to skip printout.');
  236.       GotoXY(40,24); write('---Press any key to continue.');
  237.       Read(Kbd,Ch);
  238.    End; {Opening}
  239.  
  240.    Procedure Grafit;                                                  {.CP15}
  241.    Begin
  242.       X := 0;
  243.       While Not(EOF(Fil)) and (X<319) do begin
  244.          read(Fil,Dat);
  245.          S2  := 199 - Pct(Dat.Sharks);
  246.          Fh2 := 199 - Pct(Dat.Fhigh);
  247.          Fl2 := 199 - Pct(Dat.Flow);
  248.          if X>0 then DrawLine;
  249.          S1  := S2;
  250.          Fh1 := Fh2;
  251.          Fl1 := Fl2;
  252.          X   := X + 1
  253.       End {while}
  254.    End; {Grafit}
  255.  
  256.    Procedure PrintGraf;                                               {.CP29}
  257.    Var
  258.       Regs: regpack;
  259.    Begin
  260.       writeln(Lst);
  261.       writeln(Lst);
  262.       writeln(Lst);
  263.       writeln(Lst);
  264.       Writeln(Lst,' ':14,#27,'E',#14,'1st 320 Chronons on Wa-Tor',#27,'F');
  265.       Intr(5,Regs);
  266.       Writeln(lst,#27,'E');
  267.       Writeln(Lst,' ':15,'Verticals indicate 100 Chronons.');
  268.       writeln(Lst);
  269.       Writeln(Lst,' ':15,'Double line indicates % of Ocean occupied by fish.');
  270.       writeln(Lst,' ':18,'Lower line shows low after sharks have fed.');
  271.       writeln(Lst,' ':18,'Upper line shows fish recovery after breeding.');
  272.       writeln(Lst);
  273.       writeln(Lst,' ':15,'Single line indicates % of Ocean occupied by sharks.');
  274.       writeln(Lst);
  275.       writeln(Lst,' ':15,'Initial Conditions:');
  276.       writeln(Lst);
  277.       writeln(Lst,' ':15,'    Number of sharks:    ',Shark:5,' (',
  278.           round(Pct(Shark)/2),'% of Ocean)');
  279.       writeln(Lst,' ':15,'    Number of fish:      ',Fish:5,' (',
  280.           round(Pct(Fish)/2),'% of Ocean)');
  281.       writeln(Lst,' ':15,'    Fish breeding cycle: ',Fbr:5,' chronons');
  282.       writeln(Lst,' ':15,'    Shark breeding cycle:',Sbr:5,' chronons');
  283.       writeln(Lst,' ':15,'    Sharks starve after: ',Sdie:5,
  284.                                 ' chronons without feeding');
  285.       writeln(Lst,#27,'F',#12);
  286.    End; {PrintGraf}
  287.  
  288.    Function Pct;                                                       {.CP7}
  289.    Var
  290.       R:              real;
  291.    Begin
  292.       R := X/6.25;
  293.       Pct := Round(R)
  294.    End; {Function Pct}
  295.  
  296.    Begin {WaGraf}                                                     {.CP15}
  297.       OpenDataFile;
  298.       Opening;
  299.       GraphMode;
  300.       GraphBackGround(0);
  301.       Palette(0);
  302.       GrBox;
  303.       GetInitial;
  304.       Grafit;
  305.       Close(Fil);
  306.       Read(Kbd,Ch);
  307.       if Ch in ['P','p'] then PrintGraf;
  308.       TextMode(BW80)
  309.    End; {WaGraf}
  310.  
  311. Overlay Procedure WaRead;                                             {.CP22}
  312.  
  313.    Procedure GetChoice;
  314.    Begin
  315.       Ch := #0;
  316.       writeln;
  317.       repeat
  318.          writeln;
  319.          write('Do you want the table on the Screen or on Paper? (S/P) ':67);
  320.          Read(trm,Ch);
  321.          Writeln;
  322.          if not (Ch in ['S','s','P','p']) then
  323.             writeln('You must answer S or P ':51)
  324.       until Ch in ['S','s','P','p'];
  325.       Case Ch of
  326.          'S','s':    Begin
  327.                         assign(Op,'Con:');
  328.                         Lin := 21
  329.                      end;
  330.          'P','p':    Begin
  331.                         assign(Op,'Lst:');
  332.                         Lin := 59
  333.                      end;
  334.       end {case}
  335.    End; {GetChoice}
  336.  
  337.  
  338.    Procedure Header;                                                  {.CP17}
  339.    Begin
  340.       Read(Fil,Dat);
  341.       Writeln(Op);
  342.       If Lin>40 then write(Op,' ':10);
  343.       Writeln(Op,'Wa-Tor World Record':45);
  344.       If Lin>40 then write(Op,' ':10);
  345.       Writeln(Op,'Initial Data:');
  346.       With Dat do begin
  347.          If Lin>40 then write(Op,' ':10);
  348.          writeln(Op,'Number of sharks: ':31,Sharks,
  349.             'Number of Fish: ':20,Fhigh);
  350.          If Lin>40 then write(Op,' ':10);
  351.          writeln(Op,'Sharks starve: ':25,Sdied,'   Sharks breed: ',Sbred,
  352.             '   Fish breed: ',Fbred);
  353.       end {with Dat}
  354.    End; {Header}
  355.  
  356.       Procedure PrintLine;                                             {.CP6}
  357.       Begin
  358.          If Lin>40 then write(Op,' ':10);
  359.          writeln(Op,Chron:4,'   ',Dat.Sharks:7,Dat.Fhigh:9,Dat.Flow:9,
  360.             Dat.Sbred:12,Dat.Fbred:8,Dat.Sdied:8,Dat.Featen:8)
  361.       end; {PrintLine}
  362.  
  363.       Procedure PrintPage;                                             {.CP9}
  364.       Begin
  365.          While (not EOF(Fil)) and (R<Lin) do begin
  366.             read(Fil,Dat);
  367.             PrintLine;
  368.             R := R + 1;
  369.             Chron := Chron + 1;
  370.          End {While}
  371.       End; {PrintPage}
  372.  
  373.       Procedure PrintHead;                                            {.CP12}
  374.       Begin
  375.          If page>1 then writeln(Op);
  376.          If (Lin>40) and (Page>1) then
  377.             writeln(Op,'Page ':75, Page)
  378.          else
  379.             writeln(Op);
  380.          If Lin>40 then write(Op,' ':10);
  381.          Writeln(Op,'Chronon   Sharks  Fish Hi  Fish Lo',
  382.             'S Bred':11,'F Bred':8,'S Died':8,'  F Eaten');
  383.          Writeln(Op);
  384.       End; {PrintHead}
  385.  
  386.       Procedure PrintText;                                            {.CP21}
  387.       Begin
  388.          While not EOF(Fil) do Begin
  389.             If page=1 then
  390.                R := 4
  391.             else
  392.                R := 1;
  393.             PrintHead;
  394.             PrintPage;
  395.             If Lin<40 then begin
  396.                write('---Press any key to continue':70);
  397.                read(kbd,Ch);
  398.                ClrScr
  399.             end {if Lin}
  400.             else
  401.                write(Op, #12);
  402.             Page := Page + 1
  403.          end {while}
  404.       End; {PrintText}
  405.  
  406.    Begin {WaRead}                                                     {.CP11}
  407.       LowVideo;
  408.       GetChoice;
  409.       OpenDataFile;
  410.       Chron := 1;
  411.       Page := 1;
  412.       rewrite(Op);
  413.       Header;
  414.       PrintText;
  415.       close(Fil)
  416.    end; {WaRead}
  417.  
  418. Overlay Procedure WaTorRun;                                           {.CP20}
  419.    Const
  420.       Fsymb: char    =  #250;     {Symbol for fish}
  421.       Ssymb: char    =  #33;      {Symbol for shark}
  422.       BabySSymb:Char =  #39;      {Symbol for newborn shark}
  423.  
  424.    Var
  425.       Fbr:            byte;       {Fish breeds on Nth Chronon after breeding}
  426.       Sbr:            byte;       {Shark breeds on Nth Chronon}
  427.       Sdie:           byte;       {Shark dies on Nth day after eating}
  428.       MaxF, MaxS,
  429.       MinS, MinF,
  430.       Chronon,
  431.       Nfish, Nshark:  integer;
  432.       Ocean:          array[0..24,0..49] of byte;
  433.       F, Fbase,
  434.       LastF, NewF:    Fpoint;
  435.       S, SBase,
  436.       LastS, NewS:    Spoint;
  437.       KeepRec:        boolean;
  438.  
  439.    Function Strs(B: integer): Str3; forward;
  440.  
  441.    Function LocF(F: Fpoint): byte; forward;
  442.    
  443.    Function LocS(S: Spoint): byte; forward;
  444.  
  445.    Procedure Markit(Row,Col,B: byte);                                 {.CP24}
  446.    Begin
  447.       Ocean[Row,Col]:= B;
  448.       Row := Row+1;
  449.       Col := Col+14;
  450.       case B of
  451.          0:  Begin
  452.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  453.                 Mem[Seg:(Col*2+(Row-1)*160)] := 32
  454.              End;
  455.          1:  Begin
  456.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  457.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(Fsymb)
  458.              End;
  459.          2:  Begin
  460.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  461.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(Ssymb)
  462.              End;
  463.          3:  begin
  464.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 15;
  465.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(BabySsymb)
  466.              end
  467.       end {case}
  468.    End; {Markit}
  469.    
  470.    Procedure Billboard(FS: char);                                     {.CP20}
  471.    Begin
  472.       LowVideo;
  473.       If (FS='F') or (FS='B') then begin
  474.          GotoXY(66,3); write(' Fish:  ',NFish:5);
  475.          GotoXY(66,13); write('     ',MaxF:4);
  476.          GotoXY(66,11); write('     ',MinF:4)
  477.       end; {if F}
  478.       If (FS='S') or (FS='B') then begin
  479.          GotoXY(1,3);  write(' Shark: ',NShark:5);
  480.          GotoXY(1,13);  write('     ',MaxS:4);
  481.          GotoXY(1,11);  write('     ',MinS:4)
  482.       end; {else}
  483.       GotoXY(1,10);  write(' Range:');
  484.       GotoXY(66,10); write(' Range:');
  485.       GotoXY(1,12);  write('      to');
  486.       GotoXY(66,12); write('      to');
  487.       GotoXY(1,1); write('Chronon ',Chronon,': ');
  488.       GotoXY(66,1); write('Chronon ',Chronon,': ')
  489.    End; {Billboard}
  490.    
  491.    Procedure Initialize;                                              {.CP19}
  492.    var
  493.       R,C:            byte;
  494.       Ch:             char;
  495.       LineNum:        integer;
  496.  
  497.       Procedure StartFile;
  498.       Begin
  499.          Assign(Fil,'WA-TOR.DAT');
  500.          Rewrite(Fil);
  501.          Dat.Sharks := Nshark;
  502.          Dat.Fhigh  := Nfish;
  503.          Dat.Flow   := Nfish;
  504.          Dat.SBred  := Sbr;
  505.          Dat.Sdied  := Sdie;
  506.          Dat.Fbred  := Fbr;
  507.          Dat.Featen := 0;
  508.          write(Fil, Dat)
  509.       End; {StartFile}
  510.    
  511.       Procedure Logo;                                                 {.CP18}
  512.       Const
  513.         A = '  █           █     █          █████████   █████    ██████   ';
  514.         B = '   █         █     █ █             █      █     █   █     █  ';
  515.         C = '    █   █   █     █   █   ████     █     █       █  ██████   ';
  516.         D = '     █ █ █ █     ███████           █      █     █   █   █    ';
  517.         E = '      █   █     █       █          █       █████    █    █   ';
  518.         LN = 3;
  519.  
  520.       Begin
  521.          LowVideo;
  522.          Ctr('WELCOME TO',2);
  523.          Ctr(A,LN+1);
  524.          Ctr(B,LN+2);
  525.          Ctr(C,LN+3);
  526.          Ctr(D,LN+4);
  527.          Ctr(E,LN+5);
  528.       end; {Logo}
  529.  
  530.       Procedure NextPage;                                              {.CP6}
  531.       Begin
  532.          GotoXY(40,25); write('---To continue press any key.');
  533.          Read(Kbd,Ch);
  534.          ClrScr
  535.       End; {NextPage}
  536.  
  537.      Procedure Palaver;                                               {.CP17}
  538.      Begin
  539.       LowVideo;
  540.       Ctr('Wa-Tor is a distant planet, discovered by A. K. Dewdney in  ',10);
  541.       Ctr('the Scientific American in December of 1984.  It is toroidal',11);
  542.       Ctr('in form and entirely covered with a liquid, largely composed',12);
  543.       Ctr('of an oxide of hydrogen.  Its fauna consists of two species:',13);
  544.       Ctr('a predator sufficiently comparable to the terrestrial shark ',14);
  545.       Ctr('to permit the use of that name, and a prey species which we ',15);
  546.       Ctr('may refer to as "fish".  Both species are parthenogenic.    ',16);
  547.       Ctr('The interest which this simple biosystem holds for us is due',18);
  548.       Ctr('to the fact that the frequency with which the "sharks" must ',19);
  549.       Ctr('feed, the breeding rates, and even the initial numbers of   ',20);
  550.       Ctr('the two species are entirely determinable by the observer.  ',21);
  551.       Ctr('This makes the planet an excellent site for ecological ex-  ',22);
  552.       Ctr('periment free of extraneous factors affecting species sur-  ',23);
  553.       Ctr('vival.                                                      ',24);
  554.       NextPage;
  555.       LowVideo;                                                     {.CP19}
  556.       Ctr('The behavior of the two species are as follows:              ',1);
  557.       Ctr('The ocean in which the "sharks" and "fish" swim forms a rect-',3);
  558.       Ctr('angular grid, and once every chronon, each organism moves one',4);
  559.       Ctr('step along this grid, space permitting.                      ',5);
  560.       Ctr('"Fish" move at random if an unoccupied place is available.   ',7);
  561.       Ctr('"Sharks" also move at random except that they will always    ',9);
  562.       Ctr('move to catch a fish if one adjoins.                         ',10);
  563.       Ctr('At breeding age, "fish" divide, after the manner of amoeba,  ',12);
  564.       Ctr('provided space is available.                                 ',13);
  565.       Ctr('"Sharks" breed by calving.  The calf emerges alongside its   ',15);
  566.       Ctr('mother, fully fed.  The mother, however, has sacrificed her  ',16);
  567.       Ctr('chance to feed during that chronon.  A calf will not enter   ',17);
  568.       Ctr('it''s breeding cycle until it has fed at least once.          ',18);
  569.       Ctr('"Sharks" must feed at regular intervals, the length of which ',20);
  570.       Ctr('varies with the observer''s choice.  A "shark" will die if it ',21);
  571.       Ctr('fails to feed within the required time period.               ',22);
  572.       NextPage;
  573.      end; {Palaver}
  574.  
  575.       Procedure GetParameters;                                        {.CP18}
  576.       Var
  577.          Ans:         char;
  578.  
  579.          Procedure WantRec;
  580.          Begin
  581.             writeln;
  582.             repeat
  583.                write('Keep a record (Y/N)? ':50);
  584.                read(Trm,Ans); writeln; writeln;
  585.                If not (Ans in ['Y','y','N','n']) then
  586.                   writeln('You must answer Y or N ':51)
  587.             until Ans in ['Y','y','N','n'];
  588.             If Ans in ['Y','y'] then
  589.                KeepRec := True
  590.             else
  591.                KeepRec := False;
  592.          End; {WantRec}
  593.  
  594.       Begin {GetParameters}                                           {.CP19}
  595.          LowVideo;
  596.          Fbr := 0; Sbr := 0; Sdie := 0; Nfish := 0; Nshark := 0;
  597.          Ctr('Now you may specify the parameters for your experiment.',1);
  598.          Ctr('Breeding age for "fish" (in chronons): ',3);
  599.          Read(Fbr);
  600.          Ctr('Breeding age for "sharks" (chronons):  ',5);
  601.          Read(Sbr);
  602.          Ctr('"Shark" starvation time (chronons):    ',7);
  603.          Read(Sdie);
  604.          Ctr('Initial number of "fish":              ',9);
  605.          Read(Nfish);
  606.          Ctr('Initial number of "sharks":            ',11);
  607.          Readln(Nshark);
  608.          MaxF := Nfish; MinF := Nfish;
  609.          MaxS := Nshark; MinS := Nshark;
  610.          WantRec;
  611.          NextPage
  612.       End; {GetParameters}
  613.    
  614.       Procedure MakeFish;                                             {.CP17}
  615.       Var
  616.          I:           integer;
  617.       Begin
  618.          FBase := nil;
  619.          for I := 1 to NFish do begin
  620.             New(F);
  621.             F^.age := Random(Fbr);
  622.             Repeat                                           {Find a place}
  623.                F^.Row := random(25);
  624.                F^.Col := random(50)
  625.             until Ocean[F^.Row,F^.Col] = 0;
  626.             Markit(F^.Row,F^.Col,1);                         {Put a Fish there}
  627.             F^.next := FBase;
  628.             FBase := F
  629.          End {For I}
  630.       End; {MakeFish}
  631.    
  632.       Procedure MakeShark;                                            {.CP21}
  633.       Var
  634.          I:           integer;
  635.       Begin
  636.          SBase := nil;
  637.          for i := 1 to Nshark do begin
  638.             New(S);
  639.                     New(S);
  640.             S^.age := random(Sbr);
  641.             S^.ate := random(Sdie);
  642.             repeat
  643.                S^.Row := random(25);
  644.                S^.Col := random(50);
  645.             until Ocean[S^.Row,S^.Col] = 0;
  646.             Markit(S^.Row,S^.Col,2);                      {put shark in  Ocean}
  647.             S^.next := Sbase;
  648.             S^.Last := Nil;
  649.             If Sbase<>Nil then
  650.                SBase^.Last := S;
  651.             Sbase := S
  652.          End {for I}
  653.       End; {MakeShark}
  654.    
  655.       Procedure WriteItUp;                                            {.CP11}
  656.       Begin
  657.          LowVideo;
  658.          GotoXY(1,16);  write('Initial No:');
  659.          GotoXY(66,16); write('Initial No:');
  660.          GotoXY(1,17);  write(Nshark:5);
  661.          GotoXY(66,17);  write(Nfish:5);
  662.          GotoXY(1,19);  write(' Breed: ',Sbr:3);
  663.          GotoXY(66,19); write(' Breed: ',Fbr:3);
  664.          GotoXY(1,20);  write(' Starve:',Sdie:3);
  665.       End; {WriteItUp}
  666.  
  667.       Procedure WantPalaver;                                          {.CP11}
  668.       Begin
  669.          Ctr('Do you need an explanation? (Y/N) ',LineNum);
  670.          Repeat
  671.             Read(Trm,Ch);
  672.             If not (Ch in ['Y','y','N','n']) then begin
  673.                LineNum := LineNum + 1;
  674.                Ctr('You must answer Y or N ',LineNum)
  675.             end {if}
  676.          Until Ch in ['Y','y','N','n'];
  677.       End; {WantPalaver}
  678.  
  679.       Procedure ClearOcean;                                            {.CP6}
  680.       Begin
  681.          For R := 0 to 24 do
  682.             For C := 0 to 49 do
  683.                Ocean[R,C] := 0
  684.       End; {ClearOcean}
  685.    
  686.    Begin {Initialize}                                                 {.CP18}
  687.       ClrScr;
  688.       Logo;
  689.       LineNum := 10;
  690.       WantPalaver;
  691.       If Ch in ['Y','y'] then
  692.          Palaver
  693.       else
  694.          ClrScr;
  695.       GetParameters;
  696.       WriteItUp;
  697.       Chronon := 1;
  698.       ClearOcean;
  699.       MakeFish;
  700.       MakeShark;
  701.       If KeepRec then StartFile
  702.     end; {Initialize}
  703.    
  704.    Procedure SharkMove;                                               {.CP24}
  705.    Var
  706.       Moveable,
  707.       Fed:            boolean;
  708.       Place:          byte;
  709.       X,Meals,
  710.       BredS,DeadS:    integer;
  711.       TempS:          Spoint;
  712.    
  713.       Procedure KillShark(var S: Spoint);
  714.       Begin
  715.          Markit(S^.Row,S^.Col,0);
  716.          TempS := S;
  717.          If S^.next<>Nil then
  718.             S^.next^.last := S^.last;
  719.          If S=Sbase then
  720.             Sbase := S^.next
  721.          else
  722.             S^.last^.next := S^.next;
  723.          S := S^.next;
  724.          Dispose(TempS);
  725.          NShark := NShark - 1;
  726.          DeadS := DeadS+1;
  727.       End; {KillShark}
  728.    
  729.       Procedure SearchPlaces;                                         {.CP30}
  730.       Var
  731.          Tries:       byte;
  732.       Begin
  733.          X := random(4);
  734.          Moveable := false;
  735.          Tries := 1;
  736.          Repeat
  737.             Case X of
  738.                0 : Place := Ocean[(S^.Row + 1) mod 25, S^.Col];
  739.                1 : Place := Ocean[S^.Row, (S^.Col+1) mod 50];
  740.                2 : If S^.Row = 0 then
  741.                       Place := Ocean[24, S^.Col]
  742.                    else
  743.                       Place := Ocean[S^.Row - 1, S^.Col];
  744.                3 : if S^.Col = 0 then
  745.                       Place := Ocean[S^.Row, 49]
  746.                    else
  747.                       Place := Ocean[S^.Row, S^.Col-1];
  748.             end; {Case}
  749.             If Place=1 then                           {fish there}
  750.                Moveable := True
  751.             Else if (Tries>4) and (Place=0) then      {empty place}
  752.                Moveable := True
  753.             Else begin
  754.                X := (X + 1) mod 4;
  755.                Tries := Tries + 1
  756.             End {else}
  757.          Until Moveable or (Tries>8)
  758.       End; {SearchPlaces}
  759.    
  760.       Procedure BreedShark;                                          {.CP18}
  761.       Begin
  762.          New(NewS);
  763.          S^.age := 0;
  764.          NewS^.age := 100;
  765.          NewS^.ate := 0;
  766.          NewS^.Row := S^.Row;
  767.          NewS^.Col := S^.Col;
  768.          NewS^.next := S^.next;
  769.          NewS^.Last := S;
  770.          If S^.next<>Nil then
  771.             S^.next^.last := NewS;
  772.          S^.next := NewS;
  773.          S := NewS;
  774.          Markit(S^.row,S^.Col,2);
  775.          NShark := NShark + 1;
  776.          BredS := BredS + 1;
  777.       End; {BreedShark}
  778.  
  779.       Procedure UpDate;                                               {.CP16}
  780.       Begin
  781.          If Nshark>MaxS then MaxS := Nshark;
  782.          If Nshark<MinS then MinS :=Nshark;
  783.          If MaxF<Nfish then MaxF := Nfish;
  784.          If MinF>Nfish then MinF := Nfish;
  785.          GotoXY(1,5);  write(' Died:  ',DeadS:5);
  786.          GotoXY(1,4);  write(' Bred:  ',BredS:5);
  787.          GotoXY(66,5); write(' Eaten: ',Meals:5);
  788.          GotoXY(1,25); write('            ');
  789.          Dat.Sharks := Nshark;
  790.          Dat.Flow   := Nfish;
  791.          Dat.Sbred  := BredS;
  792.          Dat.Sdied  := DeadS;
  793.          Dat.Featen := Meals
  794.       End; {UpDate}
  795.    
  796.    Begin {SharkMove}                                                  {.CP24}
  797.       Meals := 0; DeadS := 0; BredS := 0;
  798.       LowVideo;
  799.       GotoXY(1,25); write('Sharks move');
  800.       S := SBase;
  801.       While S<>Nil do begin
  802.          S^.age := S^.age + 1;
  803.          S^.ate := S^.ate + 1;
  804.          SearchPlaces;
  805.          If Moveable then Begin       {if not moved, do not change or breed}
  806.             MarkIt(S^.row, S^.Col,0);
  807.             If (S^.age >=Sbr) and (S^.age<100) then
  808.                BreedShark;
  809.             Case X of                                   {Move}
  810.                0: S^.Row := ((S^.Row + 1) mod 25);
  811.                1: S^.Col := ((S^.Col + 1) mod 50);
  812.                2: If S^.Row = 0 then
  813.                      S^.Row := 24
  814.                   else S^.Row := S^.Row - 1;
  815.                3: If S^.Col = 0 then
  816.                      S^.Col := 49
  817.                   else S^.Col := S^.Col - 1
  818.             End; {case}
  819.             If LocS(S)=1 then                       {Got a fish}      {.CP21}
  820.                Fed := true
  821.             else
  822.                Fed := False;
  823.             If S^.age>99 then                       {if immature, so marked}
  824.                MarkIt(S^.row, S^.Col,3)               {for one more chronon}
  825.             else
  826.                MarkIt(S^.row, S^.Col,2);
  827.             if Fed then begin
  828.                If S^.age>99 then S^.age := 0;           {calf matures}
  829.                S^.ate := 0;                             {full-fed}
  830.                Meals := Meals + 1;
  831.                Nfish := Nfish-1;
  832.             end; {if fish}
  833.          End; {if moveable}
  834.          If S^.ate>=Sdie then
  835.             KillShark(S)                  {KillShark returns S = next shark}
  836.          else
  837.             S := S^.next
  838.       End; {while}
  839.       UpDate
  840.    End; {Procedure SharkMove}
  841.    
  842.    Procedure FishMove;                                                 {.CP8}
  843.    Var
  844.       DoAgain,
  845.       Moveable:       boolean;
  846.       Place:          byte;
  847.       X:              byte;
  848.       TempF:          Fpoint;
  849.       BredF:          integer;
  850.    
  851.       Procedure SearchPlaces;                                         {.CP28}
  852.       Var
  853.          Tries:       byte;
  854.       Begin
  855.          X := random(4);
  856.          Moveable := false;
  857.          Tries := 1;
  858.          Repeat
  859.             Case X of
  860.                0 : Place := Ocean[(F^.Row + 1) mod 25, F^.Col];
  861.                1 : Place := Ocean[F^.Row, (F^.Col+1) mod 50];
  862.                2 : If F^.Row = 0 then
  863.                       Place := Ocean[24, F^.Col]
  864.                    else
  865.                       Place := Ocean[F^.Row - 1, F^.Col];
  866.                3 : if F^.Col = 0 then
  867.                       Place := Ocean[F^.Row, 49]
  868.                    else
  869.                       Place := Ocean[F^.Row, F^.Col-1];
  870.             end; {Case}
  871.             If Place=0  then
  872.                Moveable := True
  873.             else begin
  874.                X := (X + 1) mod 4;
  875.                Tries := Tries + 1
  876.             end {else}
  877.          Until Moveable or (Tries>4)
  878.       End; {SearchPlaces}
  879.    
  880.       Procedure BreedFish;                                            {.CP13}
  881.       Begin
  882.          New(NewF);
  883.          F^.age := 0;
  884.          NewF^.age := 0;
  885.          NewF^.Row := F^.Row;
  886.          NewF^.Col := F^.Col;
  887.          NewF^.next := F^.next;
  888.          F^.next := NewF;
  889.          Markit(NewF^.row,NewF^.Col,1);
  890.          NFish := NFish + 1;
  891.          BredF := BredF + 1;
  892.       End; {BreedFish}
  893.  
  894.       Procedure UpDate;                                               {.CP10}
  895.       Begin
  896.          If MaxF<Nfish then MaxF := Nfish;
  897.          If MinF>Nfish then MinF := Nfish;
  898.          LowVideo;
  899.          GotoXY(66,4); write(' Bred:  ',BredF:5);
  900.          GotoXY(66,25); write('          ');
  901.          Dat.Fhigh  := Nfish;
  902.          Dat.Fbred  := BredF
  903.       End; {UpDate}
  904.    
  905.       Procedure FindFirstFish;                                        {.CP17}
  906.       Begin
  907.          If Fbase<>Nil then
  908.             repeat
  909.                if (LocF(Fbase) in [2,3]) then begin        {eaten by a shark}
  910.                   TempF := Fbase;
  911.                   Fbase := Fbase^.next;
  912.                   Dispose(TempF);
  913.                end; {if}
  914.                If Fbase=Nil then
  915.                   DoAgain := false
  916.                else if (LocF(Fbase) in [2,3]) then
  917.                   DoAgain := true
  918.                else
  919.                   DoAgain := false
  920.             until not DoAgain
  921.       End; {FindFirstFish}
  922.    
  923.    Begin {FishMove}                                                   {.CP26}
  924.       LowVideo;
  925.       GotoXY(66,25); write('Fish move  ');
  926.       BredF := 0;
  927.       FindFirstFish;
  928.       F := FBase;
  929.       While (F<>Nil) and ((Nfish+Nshark)<1250) do begin
  930.          F^.age := F^.age + 1;
  931.          SearchPlaces;
  932.          If Moveable then Begin       {if immoveable, do not change or breed}
  933.             MarkIt(F^.row, F^.Col,0);
  934.             If F^.age >=Fbr then
  935.                BreedFish;
  936.             Case X of                                                  {Move}
  937.                0: F^.Row := ((F^.Row + 1) mod 25);
  938.                1: F^.Col := ((F^.Col + 1) mod 50);
  939.                2: If F^.Row = 0 then
  940.                      F^.Row := 24
  941.                   else F^.Row := F^.Row - 1;
  942.                3: If F^.Col = 0 then
  943.                      F^.Col := 49
  944.                   else F^.Col := F^.Col - 1
  945.             End; {case}
  946.             MarkIt(F^.row, F^.Col,1);
  947.          End; {if moveable}
  948.          If F^.Next<>Nil then                 {Get to next living fish}  {.CP18}
  949.             repeat
  950.                if (LocF(F^.next) in [2,3]) then begin        {eaten by a shark}
  951.                   TempF := F^.next;
  952.                   F^.next := F^.next^.next;
  953.                   Dispose(TempF)
  954.                end; {if}
  955.                If F^.next=Nil then
  956.                   DoAgain := false
  957.                else if LocF(F^.next) in [2,3] then
  958.                   DoAgain := true
  959.                else
  960.                   DoAgain := false
  961.             until not DoAgain;
  962.          F := F^.next
  963.       End; {while}
  964.       UpDate
  965.    End; {Procedure FishMove}
  966.    
  967.    Function Strs;                                                      {.CP7}
  968.    Var
  969.       S:              str3;
  970.    Begin
  971.       Str(B,S);
  972.       Strs := S
  973.    End;
  974.    
  975.    Function LocF;                                                      {.CP4}
  976.    Begin
  977.       LocF := Ocean[F^.Row, F^.Col]
  978.    End; {Loc}
  979.    
  980.    Function LocS;                                                      {.CP4}
  981.    Begin
  982.       LocS := Ocean[S^.Row, S^.Col]
  983.    End; {Loc}
  984.    
  985.    Procedure RunIt;                                                   {.CP15}
  986.    Var
  987.       StopIt:         char;
  988.    Begin
  989.       StopIt := #0;
  990.       repeat
  991.          SharkMove;
  992.          Billboard('B');
  993.          FishMove;
  994.          Billboard('F');
  995.          Chronon := Chronon + 1;
  996.          If KeepRec then write(Fil,Dat);
  997.          If KeyPressed then read(Kbd,StopIt)
  998.       until (StopIt<>#0) or ((Nfish+Nshark) = 0)
  999.    End; {Runit}
  1000.  
  1001.    Begin {WaTorRun}                                                    {.CP9}
  1002.       LowVideo;
  1003.       Initialize;
  1004.       Billboard('B');
  1005.       If (Nfish>0) or (Nshark>0) then RunIt;
  1006.       If KeepRec then Close(Fil);
  1007.       HighVideo;
  1008.       GotoXY(35,12); write('All Over');
  1009.       GotoXY(25,13); write('--Press any key to continue--');
  1010.       Read(Kbd,Ch);
  1011.       LowVideo
  1012.    End; {WaTorRun}
  1013.  
  1014. Begin {main}
  1015.    GetScreen;
  1016.    WaTorRun;
  1017.    Repeat
  1018.       If Seg = $B800 then
  1019.          GetGrafOrTable
  1020.       else
  1021.          GetTableOrQuit;
  1022.       Case GrafOrTable of
  1023.          Graf:   WaGraf;
  1024.          Table:  WaRead
  1025.       End; {case}
  1026.    Until GrafOrTable = Quit;
  1027.    ClrScr;
  1028.    LowVideo;
  1029.    Ctr('That''s it.  Signing off.',11);
  1030. end.